home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / gnu / gawk / gawk213b.zoo / test / chem / chem.awk < prev    next >
Text File  |  1991-04-20  |  12KB  |  492 lines

  1. BEGIN {
  2.     macros = "./chem.macros"    # CHANGE ME!!!!!
  3.  
  4.     pi = 3.141592654
  5.     deg = 57.29578
  6.     setparams(1.0)
  7.     set(dc, "up 0 right 90 down 180 left 270 ne 45 se 135 sw 225 nw 315")
  8.     set(dc, "0 n 30 ne 45 ne 60 ne 90 e 120 se 135 se 150 se 180 s")
  9.     set(dc, "300 nw 315 nw 330 nw 270 w 210 sw 225 sw 240 sw")
  10. }
  11. function init() {
  12.     printf ".PS\n"
  13.     if (firsttime++ == 0) {
  14.         printf "copy \"%s\"\n", macros
  15.         printf "\ttextht = %.6g; textwid = .1; cwid = %.6g\n", textht, cwid
  16.         printf "\tlineht = %.6g; linewid = %.6g\n", lineht, linewid
  17.     }
  18.     printf "Last: 0,0\n"
  19.     RING = "R"; MOL = "M"; BOND = "B"; OTHER = "O"    # manifests
  20.     last = OTHER
  21.     dir = 90
  22. }
  23. function setparams(scale) {
  24.     lineht = scale * 0.2
  25.     linewid = scale * 0.2
  26.     textht = scale * 0.16
  27.     db = scale * 0.2        # bond length
  28.     cwid = scale * 0.12        # character width
  29.     cr = scale * 0.08        # rad of invis circles at ring vertices
  30.     crh = scale * 0.16        # ht of invis ellipse at ring vertices
  31.     crw = scale * 0.12        # wid    
  32.     dav = scale * 0.015        # vertical shift up for atoms in atom macro
  33.     dew = scale * 0.02        # east-west shift for left of/right of
  34.     ringside = scale * 0.3        # side of all rings
  35.     dbrack = scale * 0.1        # length of bottom of bracket
  36. }
  37.  
  38.     { lineno++ }
  39.  
  40. /^(\.cstart)|(begin chem)/    { init(); inchem = 1; next }
  41. /^(\.cend)|(end)/        { inchem = 0; print ".PE"; next }
  42.  
  43. /^\./        { print; next }        # troff
  44.  
  45. inchem == 0    { print; next }        # everything else
  46.  
  47. $1 == "pic"    { shiftfields(1); print; next }    # pic pass-thru
  48. $1 ~ /^#/    { next }    # comment
  49.  
  50. $1 == "textht"    { textht = $NF; next }
  51. $1 == "cwid"    { cwid = $NF; next }
  52. $1 == "db"    { db = $NF; next }
  53. $1 == "size"    { if ($NF <= 4) size = $NF; else size = $NF/10
  54.           setparams(size); next }
  55.  
  56.     { print "\n#", $0 }    # debugging, etc.
  57.     { lastname = "" }
  58.  
  59. $1 ~ /^[A-Z].*:$/ {    # label;  falls thru after shifting left
  60.     lastname = substr($1, 1, length($1)-1)
  61.     print $1
  62.     shiftfields(1)
  63. }
  64.  
  65. $1 ~ /^\"/    { print "Last: ", $0; last = OTHER; next }
  66.  
  67. $1 ~ /bond/    { bond($1); next }
  68. $1 ~ /^(double|triple|front|back)$/ && $2 == "bond" {
  69.            $1 = $1 $2; shiftfields(2); bond($1); next }
  70.  
  71. $1 == "aromatic" { temp = $1; $1 = $2; $2 = temp }
  72. $1 ~ /ring|benz/ { ring($1); next }
  73.  
  74. $1 == "methyl"    { $1 = "CH3" }    # left here as an example
  75.  
  76. $1 ~ /^[A-Z]/    { molecule(); next }
  77.  
  78. $1 == "left"    { left[++stack] = fields(2, NF); printf("Last: [\n"); next }
  79.  
  80. $1 == "right"    { bracket(); stack--; next }
  81.  
  82. $1 == "label"    { label(); next }
  83.  
  84. /./    { print "Last: ", $0; last = OTHER }    
  85.  
  86. END    { if (firsttime == 0) error("did you forget .cstart and .cend?")
  87.       if (inchem) printf ".PE\n"
  88. }
  89.  
  90. function bond(type,    i, goes, from) {
  91.     goes = ""
  92.     for (i = 2; i <= NF; i++)
  93.         if ($i == ";") {
  94.             goes = $(i+1)
  95.             NF = i - 1
  96.             break
  97.         }
  98.     leng = db
  99.     from = ""
  100.     for (cf = 2; cf <= NF; ) {
  101.         if ($cf ~ /(\+|-)?[0-9]+|up|down|right|left|ne|se|nw|sw/)
  102.             dir = cvtdir(dir)
  103.         else if ($cf ~ /^leng/) {
  104.             leng = $(cf+1)
  105.             cf += 2
  106.         } else if ($cf == "to") {
  107.             leng = 0
  108.             from = fields(cf, NF)
  109.             break
  110.         } else if ($cf == "from") {
  111.             from = dofrom()
  112.             break
  113.         } else if ($cf ~ /^#/) {
  114.             cf = NF+1
  115.             break;
  116.         } else {
  117.             from = fields(cf, NF)
  118.             break
  119.         }
  120.     }
  121.     if (from ~ /( to )|^to/)    # said "from ... to ...", so zap length
  122.         leng = 0
  123.     else if (from == "")    # no from given at all
  124.         from = "from Last." leave(last, dir) " " fields(cf, NF)
  125.     printf "Last: %s(%.6g, %.6g, %s)\n", type, leng, dir, from
  126.     last = BOND
  127.     if (lastname != "")
  128.         labsave(lastname, last, dir)
  129.     if (goes) {
  130.         $0 = goes
  131.         molecule()
  132.     }
  133. }
  134.  
  135. function dofrom(    n, s) {
  136.     cf++    # skip "from"
  137.     n = $cf
  138.     if (n in labtype)    # "from Thing" => "from Thing.V.s"
  139.         return "from " n "." leave(labtype[n], dir)
  140.     if (n ~ /^\.[A-Z]/)    # "from .V" => "from Last.V.s"
  141.         return "from Last" n "." corner(dir)
  142.     if (n ~ /^[A-Z][^.]*\.[A-Z][^.]*$/)    # "from X.V" => "from X.V.s"
  143.         return "from " n "." corner(dir)
  144.     return fields(cf-1, NF)
  145. }
  146.  
  147. function bracket(    t) {
  148.     printf("]\n")
  149.     if ($2 == ")")
  150.         t = "spline"
  151.     else
  152.         t = "line"
  153.     printf("%s from last [].sw+(%.6g,0) to last [].sw to last [].nw to last [].nw+(%.6g,0)\n",
  154.         t, dbrack, dbrack)
  155.     printf("%s from last [].se-(%.6g,0) to last [].se to last [].ne to last [].ne-(%.6g,0)\n",
  156.         t, dbrack, dbrack)
  157.     if ($3 == "sub")
  158.         printf("\" %s\" ljust at last [].se\n", fields(4,NF))
  159. }
  160.  
  161. function molecule(    n, type) {
  162.     n = $1
  163.     if (n == "BP") {
  164.         $1 = "\"\" ht 0 wid 0"
  165.         type = OTHER
  166.     } else {
  167.         $1 = atom(n)
  168.         type = MOL
  169.     }
  170.     gsub(/[^A-Za-z0-9]/, "", n)    # for stuff like C(OH3): zap non-alnum
  171.     if ($2 == "")
  172.         printf "Last: %s: %s with .%s at Last.%s\n", \
  173.             n, $0, leave(type,dir+180), leave(last,dir)
  174.     else if ($2 == "below")
  175.         printf("Last: %s: %s with .n at %s.s\n", n, $1, $3)
  176.     else if ($2 == "above")
  177.         printf("Last: %s: %s with .s at %s.n\n", n, $1, $3)
  178.     else if ($2 == "left" && $3 == "of")
  179.         printf("Last: %s: %s with .e at %s.w+(%.6g,0)\n", n, $1, $4, dew)
  180.     else if ($2 == "right" && $3 == "of")
  181.         printf("Last: %s: %s with .w at %s.e-(%.6g,0)\n", n, $1, $4, dew)
  182.     else
  183.         printf "Last: %s: %s\n", n, $0
  184.     last = type
  185.     if (lastname != "")
  186.         labsave(lastname, last, dir)
  187.     labsave(n, last, dir)
  188. }
  189.  
  190. function label(    i, v) {
  191.     if (substr(labtype[$2], 1, 1) != RING)
  192.         error(sprintf("%s is not a ring", $2))
  193.     else {
  194.         v = substr(labtype[$2], 2, 1)
  195.         for (i = 1; i <= v; i++)
  196.             printf("\"\\s-3%d\\s0\" at 0.%d<%s.C,%s.V%d>\n", i, v+2, $2, $2, i)
  197.     }
  198. }
  199.  
  200. function ring(type,    typeint, pt, verts, i) {
  201.     pt = 0    # points up by default
  202.     if (type ~ /[1-8]$/)
  203.         verts = substr(type, length(type), 1)
  204.     else if (type ~ /flat/)
  205.         verts = 5
  206.     else
  207.         verts = 6
  208.     fused = other = ""
  209.     for (i = 1; i <= verts; i++)
  210.         put[i] = dbl[i] = ""
  211.     nput = aromatic = withat = 0
  212.     for (cf = 2; cf <= NF; ) {
  213.         if ($cf == "pointing")
  214.             pt = cvtdir(0)
  215.         else if ($cf == "double" || $cf == "triple")
  216.             dblring(verts)
  217.         else if ($cf ~ /arom/) {
  218.             aromatic++
  219.             cf++    # handled later
  220.         } else if ($cf == "put") {
  221.             putring(verts)
  222.             nput++
  223.         } else if ($cf ~ /^#/) {
  224.             cf = NF+1
  225.             break;
  226.         } else {
  227.             if ($cf == "with" || $cf == "at")
  228.                 withat = 1
  229.             other = other " " $cf
  230.             cf++
  231.         }
  232.     }
  233.     typeint = RING verts pt        # RING | verts | dir
  234.     if (withat == 0)
  235.         fused = joinring(typeint, dir, last)
  236.     printf "Last: [\n"
  237.     makering(type, pt, verts)
  238.     printf "] %s %s\n", fused, other
  239.     last = typeint
  240.     if (lastname != "")
  241.         labsave(lastname, last, dir)
  242. }
  243.  
  244. function makering(type, pt, v,       i, a, r) {
  245.     if (type ~ /flat/)
  246.         v = 6
  247.     # vertices
  248.     r = ringside / (2 * sin(pi/v))
  249.     printf "\tC: 0,0\n"
  250.     for (i = 0; i <= v+1; i++) {
  251.         a = ((i-1) / v * 360 + pt) / deg
  252.         printf "\tV%d: (%.6g,%.6g)\n", i, r * sin(a), r * cos(a)
  253.     }
  254.     if (type ~ /flat/) {
  255.         printf "\tV4: V5; V5: V6\n"
  256.         v = 5
  257.     }
  258.     # sides
  259.     if (nput > 0) {    # hetero ...
  260.         for (i = 1; i <= v; i++) {
  261.             c1 = c2 = 0
  262.             if (put[i] != "") {
  263.                 printf("\tV%d: ellipse invis ht %.6g wid %.6g at V%d\n",
  264.                     i, crh, crw, i)
  265.                 printf("\t%s at V%d\n", put[i], i)
  266.                 c1 = cr
  267.             }
  268.             j = i+1
  269.             if (j > v)
  270.                 j = 1
  271.             if (put[j] != "")
  272.                 c2 = cr
  273.             printf "\tline from V%d to V%d chop %.6g chop %.6g\n", i, j, c1, c2
  274.             if (dbl[i] != "") {    # should check i<j
  275.                 if (type ~ /flat/ && i == 3) {
  276.                     rat = 0.75; fix = 5
  277.                 } else {
  278.                     rat = 0.85; fix = 1.5
  279.                 }
  280.                 if (put[i] == "")
  281.                     c1 = 0
  282.                 else
  283.                     c1 = cr/fix
  284.                 if (put[j] == "")
  285.                     c2 = 0
  286.                 else
  287.                     c2 = cr/fix
  288.                 printf "\tline from %.6g<C,V%d> to %.6g<C,V%d> chop %.6g chop %.6g\n",
  289.                     rat, i, rat, j, c1, c2
  290.                 if (dbl[i] == "triple")
  291.                     printf "\tline from %.6g<C,V%d> to %.6g<C,V%d> chop %.6g chop %.6g\n",
  292.                         2-rat, i, 2-rat, j, c1, c2
  293.             }
  294.         }
  295.     } else {    # regular
  296.         for (i = 1; i <= v; i++) {
  297.             j = i+1
  298.             if (j > v)
  299.                 j = 1
  300.             printf "\tline from V%d to V%d\n", i, j
  301.             if (dbl[i] != "") {    # should check i<j
  302.                 if (type ~ /flat/ && i == 3) {
  303.                     rat = 0.75
  304.                 } else
  305.                     rat = 0.85
  306.                 printf "\tline from %.6g<C,V%d> to %.6g<C,V%d>\n",
  307.                     rat, i, rat, j
  308.                 if (dbl[i] == "triple")
  309.                     printf "\tline from %.6g<C,V%d> to %.6g<C,V%d>\n",
  310.                         2-rat,